home *** CD-ROM | disk | FTP | other *** search
/ TPUG - Toronto PET Users Group / TPUG Users Group CD / TPUG Users Group CD.iso / TPUG Xtras / Xtras / progdisk.d64 / piano (.txt) < prev    next >
Commodore BASIC  |  2009-02-07  |  6KB  |  168 lines
  1. 200 GOTO 460
  2. 210 :
  3. 220 :
  4. 230 REM SLIDE SUBROUTINE
  5. 240 IF RA<0 THEN RA=R
  6. 250 RB=R:T=S+V*Z7:POKEVN,V*Z7:POKENL,FL(RA):POKENH,FH(RA):SYSS2:POKET+Z4,WV+Z1
  7. 260 FORI=RATORBSTEPSGN(RB-RA)/2:POKET,FL(I):POKET+1,FH(I):NEXT
  8. 270 IF PEEK(IK)=JANDPEEK(IK)-64THEN 270
  9. 280 RA=RB:POKET+Z4,WV+P:V=V+MN*(Z1+Z3*(V=Z2)):RETURN
  10. 290 :
  11. 300 REM CHORD SUBROUTINE
  12. 310 POKEBF,Z0:FORI=Z0TOZ2:A=R+C(C1,C2,I):POKEVN,I*Z7:POKENL,FL(A)
  13. 320 POKENH,FH(A):SYSS2:NEXT:POKES+Z4,WV+Z1:POKES+11,WV+Z1:POKES+18,WV+Z1
  14. 330 IF PEEK(IK)=JANDPEEK(IK)-64 THEN 330
  15. 340 POKES+Z4,WV+P:POKES+11,WV+P:POKES+18,WV+P:RETURN
  16. 350 :
  17. 360 REM POLYPHONIC SUBROUTINE
  18. 370 A=PEEK(IK):SYSS1:J=PEEK(ET):IFJ=Z0ORA=ZS THEN RETURN
  19. 380 FORI=Z1TOJ:R=K(PEEK(ET+I))+OC:IF R=OC THENNEXT:RETURN
  20. 390 T(I)=V*Z7:POKEVN,T(I):POKENL,FL(R):POKENH,FH(R):SYSS2
  21. 400 IF MN THEN V=V+Z1:IF V=Z3THENV=Z0
  22. 410 NEXT:FORI=Z1TOJ:POKES+T(I)+Z4,WV+Z1:NEXT
  23. 420 SYSS1:IF J=PEEK(ET)ANDA=PEEK(IK)THEN 420
  24. 430 FORI=Z1TOJ:POKES+T(I)+Z4,WV+P:NEXT:GOTO370
  25. 440 :
  26. 450 :
  27. 460 REM INITIALIZE VARIABLES
  28. 470 PRINT"[147]"CHR$(142);CHR$(8);:POKE53280,5:POKE53281,0:POKE788,52:REM IGNORE RUN
  29. 480 FORI=1TO39:SP$=SP$+" ":LN$=LN$+"[163]":NEXT
  30. 490 PRINT"[158]OCTAVE=5  VOICE=1 :C:S:M:V[146]:P[146]: VOLUME=10"LN$
  31. 500 POKE214,23:PRINT:PRINTTAB(15)"WHIZ MASTER"
  32. 510 A$="PLEASE STAND BY":POKE214,21:PRINT:PRINTTAB(13)""A$:S=54272:GOSUB1580
  33. 520 DIMFL(134),FH(134),K(255),C(8,2,2):OC=48:VL=10:MN=1:LL=1:RA=-1
  34. 530 Z1=1:Z2=2:Z3=3:Z4=4:Z7=7:ZS=64:FF=255:HB=256
  35. 540 IK=197:BF=198:VN=251:NL=900:NH=901:ET=829:S1=49152:S2=49408:FORI=Z1TO41
  36. 550 K(ASC(MID$("Q2W3ER5T6Y7UI9O0P@-*\^ZSXDCVGBHNJM,L.:/",I)))=I:NEXT
  37. 560 PRINTTAB(13)"[159][145]"A$:R=5.8:A=10787.4138:J=Z2^(-Z1/12)
  38. 570 FORI=94TO0STEP-1:FH(I)=INT(A*R/HB):FL(I)=A*R-HB*FH(I):A=A*J:NEXT
  39. 580 PRINTTAB(13)"[145]"A$:GOSUB1310
  40. 590 :
  41. 600 REM READ ALL DATA
  42. 610 FOR I=Z0TO8:FORJ=Z0TOZ2:READC(I,J,0),C(I,J,1),C(I,J,2):NEXT:READC$(I):NEXT
  43. 620 READ NM$(0),NM$(1),NM$(2):FORI=1TO8:READAD(I),SR(I),WV(I),PL(I),PH(I):NEXT
  44. 630 FORR=1TO2:READI,J:FORA=ITOJ:READIN:POKEA,IN:NEXT:NEXT
  45. 640 PRINT" HOLD RUN/STOP AND PRESS RESTORE TO END":I=1:GOSUB860
  46. 650 :
  47. 660 :
  48. 670 REM NUCLEUS
  49. 680 WAITBF,FF:J=PEEK(IK):GETA$:R=K(ASC(A$))+OC:IFR=OC THEN GOSUB 800:GOTO680
  50. 690 IF SL THEN GOSUB 240:GOTO 680
  51. 700 IF CH THEN GOSUB 310:GOTO 680
  52. 710 IF LL THEN GOSUB 370:GOTO 680
  53. 720 T=S+V*Z7:POKEVN,V*Z7:POKENL,FL(R):POKENH,FH(R):SYSS2:POKET+Z4,WV+Z1
  54. 730 IF MNTHEN V=V+Z1:IF V=Z3 THEN V=Z0
  55. 740 IF PEEK(IK)=JANDPEEK(IK)-64THEN740
  56. 750 POKET+Z4,WV+P:WAITBF,FF:GETA$:J=PEEK(IK):R=K(ASC(A$))+OC:IFR-OCTHEN 720
  57. 760 GOSUB800:GOTO680
  58. 770 :
  59. 780 :
  60. 790 REM PARAMETER FUNCTIONS
  61. 800 IF CH=0 THEN 830
  62. 810 FOR I=0 TO 2:IF A$=MID$("[219][221][169]",I+1,1)THENC2=I:PRINT""TAB(23)NM$(I):RETURN
  63. 820 NEXT:A=ASC(A$):IFA>32 AND A<42 THEN C1=A-33:PRINT""TAB(11)C$(C1):RETURN
  64. 830 FORI=1TO8:IF A$<>MID$("[144][159][156][158]",I,1)THENNEXT:GOTO 850
  65. 840 OC=12*(I-Z1):PRINT""TAB(7)MID$(STR$(I),2):RETURN
  66. 850 FORI=1TO8:IFA$<>MID$("[129][149][150][151][152][153][154][155]",I,1)THEN NEXT:GOTO 880
  67. 860 POKE902,PL(I):POKE903,PH(I):WV=WV(I):POKE904,WV:POKE905,AD(I):POKE906,SR(I)
  68. 870 PRINT""TAB(16)MID$(STR$(I),2):RETURN
  69. 880 IF A$<>"[133]" AND A$<>"[134]"THEN 930
  70. 890 VL=VL-(VL<15 AND A$="[133]")+(VL>0 ANDA$="[134]"):POKES+24,VL
  71. 900 PRINT""TAB(37)RIGHT$("0"+MID$(STR$(VL),2),2):RETURN
  72. 910 :
  73. 920 REM STYLE FUNCTIONS
  74. 930 IFA$="[138]" THEN P=1-P:POKE1047,13+128*P:GOTO1580
  75. 940 IFA$="[139]"THEN MN=1-MN:POKE1049,22+128*MN:GOTO1580
  76. 950 IFA$="[140]"THENLL=1-LL:POKE1051,16+128*LL:RETURN
  77. 960 IFA$="[136]"THEN SL=1-SL:RA=-1:POKE1045,19+128*SL:CH=1:GOTO990
  78. 970 IF A$<>"[135]" THEN 1010
  79. 980 POKE1045,19:SL=0
  80. 990 CH=1-CH:POKE1043,3+128*CH:IFCH=0THENPRINT""LN$:PRINTSP$:RETURN
  81. 1000 PRINT""SP$"[145]CHORD TYPE:"C$(C1)TAB(23)NM$(C2)" INVERSION"LN$:RETURN
  82. 1010 IF A$=" "THEN GOSUB 1580:RA=-1:POKEBF,Z0:RETURN
  83. 1020 IF A$="" THEN GOSUB1580:PRINT"[147]":POKE788,49:END
  84. 1030 IF A$<>"[137]"THEN RETURN
  85. 1040 :
  86. 1050 :
  87. 1060 REM DISPLAY WAVEFORM PARAMETERS
  88. 1070 GOSUB1470:POKE214,13:PRINT
  89. 1080 PRINT"VOICE TO BE DEFINED (1-8)";:J=1:GOSUB1500
  90. 1090 IF IN<1 OR IN>8 THEN GOSUB 1470:GOTO1400
  91. 1100 I=IN:PRINTTAB(31)"ATT:"MID$(STR$(INT(AD(I)/16)),2)
  92. 1110 PRINTTAB(31)"DEC:"MID$(STR$(AD(I)AND15),2)
  93. 1120 PRINTTAB(31)"SUS:"MID$(STR$(INT(SR(I)/16)),2)
  94. 1130 PRINTTAB(31)"REL:"MID$(STR$(SR(I)AND15),2)
  95. 1140 PRINTTAB(31)"WVF:"MID$("SAWTRIPULNSE",3*LOG(WV(I))/LOG(2)-11,3)
  96. 1150 IF WV(I)=64 THENPRINTTAB(31)"PLS:"MID$(STR$(PH(I)*HB+PL(I)),2)
  97. 1160 :
  98. 1170 REM DEFINE A NEW WAVEFORM
  99. 1180 POKE 214,14:PRINT:PRINT"ATTACK RATE (0-15)";:J=2:GOSUB1500:IFERTHEN1070
  100. 1190 AD=IN:PRINT"DECAY RATE (0-15)";:GOSUB1500:IFERTHEN1070
  101. 1200 AD=AD*16ORIN:PRINT"SUSTAIN LEVEL (0-15)";:GOSUB1500:IFERTHEN 1070
  102. 1210 SR=IN:PRINT"RELEASE RATE (0-15)";:GOSUB1500:IFERTHEN1070
  103. 1220 SR=SRS*16ORIN
  104. 1224 PRINT"SAW TRI PULSE NOISE (STPN)";:J=1:GOSUB1500:PRINT"";
  105. 1230 FORJ=1TO4:IFIN$<>MID$("STPN",J,1)THENNEXT:GOTO1070
  106. 1240 WF=2^(J+3):IF WF<>64 THEN 1260
  107. 1250 PRINT"PULSE RATE (0-4095)";:J=4:GOSUB1500:PU=IN:IF IN<0 OR IN>4095THEN 1070
  108. 1260 WV(I)=WF:PL(I)=PU-HB*INT(PU/HB):PH(I)=INT(PU/HB):AD(I)=AD:SR(I)=SR
  109. 1270 GOSUB1470:GOSUB1410:GOTO860
  110. 1280 :
  111. 1290 :
  112. 1300 REM DISPLAY KEYBOARDS
  113. 1310 POKES+24,VL:PRINT""TAB(10)"[167]   [221]   [221]   [221]    "
  114. 1320 PRINT"   LOW    [167] [146]2 [146]3 [221][146]5 [146]6 [146]7 [221] [146]9 [146]0 [221] [146]- [146]\ S "
  115. 1330 PRINT" KEYBOARD [167][160][221][160][221][160][221][160][221][160][221][160][221][160][221][160][221][160][221][160][221][160][221][160][221] [221] "
  116. 1340 PRINTTAB(10)"[167]Q[221]W[221]E[221]R[221]T[221]Y[221]U[221]I[221]O[221]P[221]@[221]*[221]^[221] "
  117. 1350 PRINTTAB(14)"[170]   [221]    [221]   [146][180]"
  118. 1360 PRINT"   HIGH       [170] [146]S [146]D [221] [146]6 [146]H [146]J [221] [146]L [146]: [146][180]"
  119. 1370 PRINT" KEYBOARD     [167] [221] [221] [221] [221] [221] [221] [221] [221] [221] [146][180]"
  120. 1380 PRINTTAB(14)"[170]Z[221]X[221]C[221]V[221]B[221]N[221]M[221],[221].[221]/[146][180]"
  121. 1390 :
  122. 1400 REM DISPLAY FUNCTION MENU
  123. 1410 POKE214,13:PRINT:PRINT" F1 -- LOUDER     F2 -- DEFINE WAVEFORM
  124. 1420 [153]" F3 -- SOFTER     F4 -- MAINTAIN
  125. 1430 PRINT" F5 -- CHORDS     F6 -- MULTIVOICE
  126. 1440 [153]" F7 -- SLIDES     F8 -- POLYPHONIC":[142]
  127. 1450 :
  128. 1460 [143] CLEAR DISPLAY AREA
  129. 1470 [151]214,12:[153]:[129]J[178]1[164]8:[153]SP$:[130]:[142]
  130. 1480 :
  131. 1490 [143] INPUT SUBROUTINE
  132. 1499 [137] 1499
  133. 1500 IN$[178]"":[153]"? ";
  134. 1510 [153]" WAITCMD";:[146]BF,FF:[161]A$:[139]A$[178]""[167]1020
  135. 1520 A[178][198](A$):[139]A[178]13[167][153]" ":IN[178][197](IN$):ER[178](IN[179]0 [176] IN[177]15)[176]IN$[178]"":[142]
  136. 1530 [139] A[178]20[175][195](IN$)[167][153]" CMDCMD CMD";:IN$[178][200](IN$,[195](IN$)[171]1)
  137. 1540 [139](A[175]127)[179]35[176][195](IN$)[178]J[167]1510
  138. 1550 [153]A$;:IN$[178]IN$[170]A$:[137]1510
  139. 1560 :
  140. 1570 [143] CLEAR MUSIC CHIP
  141. 1580 [129]I[178]4[164]18[169]7:[151]S[170]I,0:[130]:[129]I[178]0[164]23:[151]S[170]I,0:[130]:[142]
  142. 1590 :
  143. 1600 :
  144. 1610 [143] CHORD DATA
  145. 1620 [131],4,7,,3,8,,5,9,"MAJOR     ",,3,7,,4,9,,5,8,"MINOR     "
  146. 1630 [131],3,6,,3,9,,6,9,"DIMINISHED",,4,8,,4,8,,4,8,"AUGMENTED "
  147. 1640 [131],4,11,,4,11,,4,11,"MAJOR 7TH ",,3,10,,3,10,,3,10,"MINOR 7TH "
  148. 1650 [131],4,10,,4,10,,4,10,"DOMIN 7TH",4,7,9,4,7,9,4,7,9,"MAJOR 6TH "
  149. 1660 [131]3,7,9,3,7,9,3,7,9,"MINOR 6TH ","  ROOT"," FIRST","SECOND"
  150. 1670 :
  151. 1680 [143] WAVEFORM PARAMETER DATA
  152. 1690 [131],249,16,,,,249,32,,,,249,64,160,15,,249,128,,,,240,16,,,204,204,16,,
  153. 1700 [131],252,64,200,,192,240,32,,
  154. 1710 :
  155. 1720 [143] MULTI INPUT ASSEMBLY CODE
  156. 1730 [131]49152,49294,120,169,,141,61,3,170,169,254,133,252,165,252,141,,220,173
  157. 1740 [131]1,220,157,143,192,232,56,38,252,176,239,162,,160,,189,143,192,42,176
  158. 1750 [131]29,72,132,253,138,10,10,10,5,253,168,185,79,192,238,61,3,172,61,3,153
  159. 1760 [131]61,3,104,192,3,240,12,164,253,200,192,8,208,219,232,224,8,208,209,88
  160. 1770 [131]96,17,135,134,133,136,29,13,20,0,69,83,90,52,65,87,51,88,84,70,67,54
  161. 1780 [131]68,82,53,86,85,72,66,56,71,89,55,78,79,75,77,48,74,73,57,44,64,58,46
  162. 1790 [131]45,76,80,43,47,94,61,1,19,59,42,92,3,81,2,32,50,4,95,49
  163. 1800 :
  164. 1810 [143] MUSICLOADER ASSEMBLY CODE
  165. 1820 [131]49408,49454,169,212,133,252,169,,160,6,145,251,136,145,251,170,169,8
  166. 1830 [131]136,145,251,138,145,251,136,192,1,208,249,188,41,193,185,132,3,145,251
  167. 1840 [131]232,224,6,208,243,96,2,3,,1,6,5
  168.